#! /usr/bin/perl -w
$^W = 1; # same as -w above

use strict;

## # unbuffered output is usually desired
## $| = 1;


=pod

=head1 capture - trace calls to pacemaker resource agents

=head1 SUMMARY

This perl script is used in a Pacemaker environment (see:
http://www.clusterlabs.org/) to trace calls to resource agents. Instead
of invoking your resource agent scripts directly, you invoke this
script. This script then executes the original resource script, feeding
it all the arguments, capturing the output from the original resource
script, and recording everything into a log file.

=head1 COPYRIGHT

Copyright 2011 Rahul Dhesi.

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

=head1 USAGE

For each ocf-type resource script called xxx, a symlink
'/usr/lib/ocf/resource.d/rahul/xxx' will point to this script, and
Pacemaker will invoke ocf:rahul:xxx in place of the original resource
script.

For each lsb-type resource script called xxx, a symlink
'/etc/init.d/capture-xxx' will point to this script, and Pacemaker will
invoke lsb:capture-xxx in place of the original resource script.

Edit the %paths table in the configuration section to hold the pathnames of
the resource scripts whose calls you wish to trace. The table contains the
name of each ocf resource script folowed by its pathname, and the capture-
prefixed name of each lsb resource script followed by its pathname.

At runtime, the contents of %path will become a lookup table of key and value
pairs.  For example, here is an excerpt from the %paths table.  All paths must
begin with either '/usr/lib/ocf/resource.d' (represented by the variable
$OCF) or with '/etc/init.d' (represented by the variable $LSB).

  my %paths = (
    'drbd',                  "$OCF/linbit/drbd",
     ...
    'capture-iscsi-target',  "$LSB/iscsi-target",
     ...
  );

Create a resource directory '/usr/lib/ocf/resource.d/rahul'. (This is defined
as $LOCALDIR in the configuration section of this script.)

Place this script (the one you are installing), with the %paths revised as you
need, into the directory '/usr/lib/ocf/resource.d/rahul'. The final pathname
of this script is '/usr/lib/ocf/resource.d/rahul/capture'.

In the directory '/usr/lib/ocf/resource.d/rahul' make a symlink for each
resource script that you want to trace. (You can do this automatically
with the 'capture -s' command described below.) Each symlink will point towards
'capture'. For example, if you cd into '/usr/lib/ocf/resource.d/rahul' and do
'ls -lF', you might see something like this:

  -r-xr-xr-x 1 root root 11842 Apr  7 17:23 capture*
  lrwxrwxrwx 1 root root     7 Apr  7 17:23 drbd -> capture*
  lrwxrwxrwx 1 root root     7 Apr  7 17:23 Filesystem -> capture*
  lrwxrwxrwx 1 root root     7 Apr  7 17:23 IPaddr2 -> capture*
  lrwxrwxrwx 1 root root     7 Apr  7 17:23 LVM -> capture*

In the directory '/etc/init.d' make a symlink for each lsb resource script you
wish to trace. (You can do this automatically with the 'capture -s'
command described below.) The name of the symlink will be the name of the
resource script prefix with 'capture-'. These symlinks will point to the full
pathname of the script which is: '/usr/lib/ocf/resource.d/rahul/capture'.

For exaple, if you cd into '/etc/init.d' and do 'ls -lF capture-*', you might
see something like this:

  lrwxrwxrwx 1 root root 37 Apr  7 17:23 capture-iscsi-target -> /usr/lib/ocf/resource.d/rahul/capture*
  lrwxrwxrwx 1 root root 37 Apr  7 17:23 capture-nfs -> /usr/lib/ocf/resource.d/rahul/capture*

Now edit your Pacemaker configuration. Wherever you wish to trace a resource
script, invoke it via this 'capture' script.

For example, to trace ocf:linbit:drbd, replace it in your Pacemaker
configuration with ocf:rahul:drbd, and make sure the %paths table maps 'drbd'
to '/usr/lib/ocf/resource.d/linbit/drbd'.  Now whenever pacemaker invokes
ocf:rahul:drbd, it executes '/usr/lib/ocf/resource.d/rahul/drbd' which, if
you followed the symlink instructions above, points to 'capture' which is this
script.  This script knows it has been invoked by the name 'drbd', so it looks
up 'drbd' in the %paths table, finds the actual location of the original
ocf:linbit:drbd script, and runs it, supplying it all the same arguments that
it itself received.  It also records all arguments and output into the log
file.

Also in the example table above, the key 'capture-iscsi-target' has as its
value the pathname '/etc/init.d/iscsi-target'. This is an example of an lsb
resource script. If your Pacemaker configuration originally specified
lsb:iscsi-target, replace that with lsb:capture-iscsi-target.  This causes
pacemaker to run '/etc/init.d/capture-iscsi-target' which is a symlink to
'/usr/lib/ocf/resource.d/rahul/capture' which is this script.  This script
knows it has been invoked by the name 'capture-iscsi-target', so it looks up
'capture-iscsi-target' in the %paths table, finds that 'capture-iscsi-target'
maps to '/etc/init.d/iscsi-target' and runs it, supplying it with all the same
arguments that it itself received.  It also records all arguments and output
into the log file.

=head1 CREATING SYMLINKS

If you invoke this script manually as

  capture -s

it will look up the %paths table and make all the needed symlinks.

=head1 LOG FILE OUTPUT

In the log file output, argument names are printed in a pruned format,
omitting common prefixes such as OCF_RESKEY_, for ease of reading. Each
output line is prefixed with the string 'cap:' and most output lines
also include the name of the resource being started/stopped/monitored.

Some heuristics are used in a number of places to simplify output.
Trailing blanks in arguments are pruned. Spurious output lines
complaining about an 'unknown facility name: none' are omitted.

Exit code 8 from an ocf-type resource is not treated as an error,
because this code indicates that the resource is running normally in a
master role.  See comments in the source code to make an ocf-type exit
code 8 be treated as an error.

The format of log lines is:

  cap: $RES: $DATE: $PPATH $ACTION ($NAME $RES) argument ...
  cap: ... anything printed by the resource agent to stdout or stderr ...
  cap: $RES ok   (0) $PPATH ($NAME $RES)
  cap: $RES ok   (8) $PPATH ($NAME $RES)
  cap: $RES ERR  ($CODE) $PPATH ($NAME $RES)

'cap:' is a fixed string.

'$RES' is the resource being started/stopped/monitored.

'$DATE' is the local date and time in the form yy-mm-dd hh:mm:ss.

'$PPATH' is the partial pathname of the resource agent script, omitting
the known prefix strings "$OCF/", "$OSB/", and 'capture-' to keep output lines
shorter.  So, for example, '/usr/lib/ocf/resource.d/linbit/drbd' would
appear in the log file as just 'linbit/drbd'. Similarly,
'/etc/init.d/capture-iscsi-target' would appear in the log file as just
'iscsi-target'.

'$ACTION' is the action performed, e.g.: start, stop, monitor, notify.

'$NAME' is the name of the resource agent, i.e., the last component of $PPATH.

'$CODE' is the exit code from the resource agent, usually a small
integer.

'ok' is printed if the exit was 0 from an lsb-type resource agent or was
0 or 8 from an ocf-type resource agent; otherwise 'ERR' is printed.

=head1 TIMEOUT

Error output and standard output from the resource agent are both
received and sent to stdout in real time, and also accumulated until the
resource agent exits and then printed all at once to the log file.  We
do this to minimize the likelihood of interspersed output lines in the
log file, which are hard to visually interpret.  To protect against the
resource agent hanging indefinitely and nothing ever being sent to the
log file, if the resource agent has not exited after $TIMEOUT seconds,
we time it out, log all output seen up to that point, log an error
message indicating the timeout, and return a general exit code of 1 to
the caller.

=head1 EXAMPLE MAKEFILE

  # May need to replace leading blanks with a tab.
  DIR = /usr/lib/ocf/resource.d/rahul
  default:
	  @echo 'Try:'
	  @echo ''
	  @echo "make install     install into '$(DIR)'"
	  @echo 'make diff        diff current and installed versions'
	  @echo 'make symlinks    make symlinks'

  .PHONY: install default diff symlinks

  install: $(DIR)/capture

  $(DIR)/capture: capture
	  perl -cw capture
	  mkdir -p $(DIR)
	  install -m 555 $< $@

  diff:
	  diff -u $(DIR)/capture capture

  symlinks:
	  perl -cw capture
	  $(DIR)/capture -s


=head1 LIMITATIONS/REQUIREMENTS

This script has been tested with perl v5.8.8 in a 64-bit Linux
environment.  Earlier versions of perl should generally be compatible.
The example Makefile was tested with GNU Make 3.81.

If a resource agent prints any error messages to standard error, they go
to standard output when its output is captured.  If a resource agent
prints error messages in response to a 'meta-data' request but returns
valid XML, the calling software may encounter an XML parsing error. If
this happens, add a * prefix to the name of the resource agent in the
%paths table. This will suppress diverting stderr to stdout for the
'meta-data' request, the * will otherwise be ignored, and any stderr
from the resource agent will not be logged during the 'meta-data'
request. The symlink name should not include the * prefix.

  my %paths = (
    # * prefix means discard stderr during 'meta-data' request
    '*ping',	           "$OCF/pacemaker/ping",
     ...
  );



=cut

$::myname = $0;
$::myname =~ s|.*/||;


## CONFIGURATION SECTION

# Almost never changed
my($OCF) = '/usr/lib/ocf/resource.d';
my($LSB) = '/etc/init.d';
my($SCRIPTNAME) = 'capture';
my($LOCALDIR) = "$OCF/rahul";

# Rarely changed
my($LOGFILE) = '/var/log/cluster/capture.log';
my($TIMEOUT) = 300; # no. of seconds to allow each resource script to complete

# Often changed
my %paths = (
  'drbd',	           "$OCF/linbit/drbd",
  'LVM',	           "$OCF/heartbeat/LVM",
  'Xen',	           "$OCF/heartbeat/Xen",
  '*ping',	           "$OCF/pacemaker/ping",
  'Filesystem',	           "$OCF/heartbeat/Filesystem",
  'IPaddr2',	           "$OCF/heartbeat/IPaddr2",
  'capture-iscsi-target',  "$LSB/iscsi-target",
  'capture-nfs-drbd',	   "$LSB/nfs-drbd",
);
## END CONFIGURATION SECTION

# suppresss perl warnings
$::debug = $::opt_x = undef;
$::ddebug = $::opt_X = undef;
$::opt_h = undef;
$::opt_s = undef;

$::divert_stderr = 1;	# divert stderr from agent into stdout

$::usage = "$::myname: usage: [-xXs] arg ...     (or -h for help)";

# parse options only if our name is 'capture'
if ($::myname eq 'capture' && @ARGV && $ARGV[0] =~ "^-.+" ) {
  local($^W) = 0;		# suppress annoying undef warnings
  require "getopts.pl";
  &Getopts("xXhs");
}

# uncomment below, thus setting $::ddebug to 1,
# to make debugging output go into pacemaker logs
## $::ddebug = 1;

$::ddebug = $::ddebug || $::opt_X;	# debug
$::debug = $::opt_x || $::ddebug;	# extended debug

# -h for help
if ($::opt_h) {
  &givehelp();
  exit(0);
}

# -s to make symlinks
if ($::opt_s) {
  exit &make_symlinks();
}

## (@ARGV < 1) && die "$::usage\n";
$::ddebug && print LOGFILE "> \@ARGV=@ARGV\n";

# get final path from our name
$::star_prefix_found = 0;

my($path) = $paths{$::myname};
defined($path) || do {
  # Try a lookup for name with * prefix
  $path = $paths{'*' . $::myname};
  $::star_prefix_found = 1;
};
defined($path) || die $::usage;

# get resource type for future use, 'ocf' or 'lsb'.
my($type);
if ($path =~ m|^${OCF}|) {
  $type = 'ocf';
} elsif ($path =~ m|^${LSB}|) {
  $type = 'lsb';
} else {
  $type = 'unknown';	# misconfiguration
}

open(LOGFILE, '>>', $LOGFILE) ||
  warn "$::myname: error: can't writ to log file '$LOGFILE': $!";

my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

my($datestamp) = sprintf("%u-%02u-%02u %02u:%02u:%02u", 
	$year + 1900, $mon + 1, $mday, $hour, $min, $sec);
# print a marker and any args and env variables

# a pruned path, without ocf path prefix, for simpler log output
my($pruned_path) = $path;
if ($type eq 'lsb') {
  $pruned_path =~ s|^${LSB}/||;
} elsif ($type eq 'ocf') {
  $pruned_path =~ s|^${OCF}/||;
}

my($data) = "$datestamp: $pruned_path";

for (@ARGV) {
  $data .= " $_";
}

# Get selected env variables for non-lsb scripts
my($instance) = '';	# an instance, e.g., filename or LVM name
my($suffix) = '';	# (restype) or (restype instance)
if ($type eq 'ocf') {
  if ($::star_prefix_found && @ARGV && $ARGV[0] eq 'meta-data') {
    $::divert_stderr = 0;	# don't divert stderr
  }
  $instance = $ENV{'OCF_RESOURCE_INSTANCE'} || '';
  my($restype) = $ENV{'OCF_RESOURCE_TYPE'} || '';
  if ($instance eq 'DUMMY_INSTANCE') {
    $suffix = " ($restype)";
    $instance = '';
    $suffix = " ($restype)";
  } else {
    $suffix = " ($restype $instance)";
  }
  $data .= $suffix;
}

my($k);
my($v);
for $k (sort keys %ENV) {
  if ($k =~ /^OCF_RESKEY_/) {
    $v = $ENV{$k};
    my($kk) = $k;
    # simploify arg strings for logging
    $kk =~ s/^OCF_RESKEY_CRM_meta_//;
    $kk =~ s/^OCF_RESKEY_CRM_//;
    $kk =~ s/^OCF_RESKEY_//;
    ($v eq '' || $v =~ /^\s*$/) && next; # omit anything with an empty value
    $v =~ s/\s+$//;	# prune trailing blanks which occur often
    if ($v =~ /\s/) {
      # if value contains any whitespace, surround it with double quotes
      # .. but first, put backslash before any existing double quotes
      $v =~ s|"|\\"|g;
      $v = '"' . $v . '"';
    }
    $data .= " $kk=$v,";
  }
}
$data =~ s/,$//;  # remove trailing comma

my($exitcode);

# Invoke main code with a timeout, in case a resource script hangs
# ... see 'perldoc -f alarm'.
eval {
  local $SIG{'ALRM'} = sub { die "alarm\n" }; # NB: \n required
  alarm $TIMEOUT;
  $exitcode  = &doitall;	# all the work is done here
  alarm 0;
};

if ($@) {
  if ($@ eq "alarm\n") {
    print LOGFILE "cap: ERROR: resource script timed out without completing\n";
    $exitcode  = 1;	# generic error
  } else {
    print LOGFILE "cap: ERROR: unexpected perl eval error:\n$@\n";
    $exitcode  = 1;	# generic error
  }
}

$::ddebug && print "> closing log file '$LOGFILE'\n";
close(LOGFILE);		# ignore log output errors

exit($exitcode);

# all the work is done here
sub doitall {
  if (open(PROGRAM, '-|')) {
    # parent
    $::debug && print "> parent process is active\n";
  } else {
    # child
    if ($::divert_stderr) {
      # send our stderr to stdout
      open STDERR, ">&STDOUT";# ignore dup error
    }
    $::debug && print "> child process is active\n";
    $::debug && print '';
    ## $| = 1;
    exec($path, @ARGV) ||
      die "error: can't exec '$path': $!\n";
  }
  # To minimize interspersed output in log file, collect lines then send
  # them all at once. However, print to stdout without delay.

  my(@lines) = ();
  push(@lines, 'cap: ' . ($instance ? "${instance}: " : '') . $data . "\n");
  while (<PROGRAM>) {
    print;		# to stdout do our caller gets it
    $::ddebug && print LOGFILE "> read: $_";
    /^\s*$/ && next;	# omit blank lines
    /logger: unknown facility name: none/ && next; # too many of these
    push(@lines, 'cap: ' . ($instance ? "${instance}: " : '') .  $_);
    $_ !~ /\n$/ && push(@lines, "\n");	# add missing newline
  }
  close(PROGRAM);
  my($exitcode) = $? >> 8;	# exit code from program

  push(@lines, 'cap: ' . 
	  ($instance ? "$instance " : '') .
	  # uncomment line B and comment out line A to treat exit
	  # code 8 as an error
	  (($exitcode == 0 || $exitcode == 8 && $type eq 'ocf') ? # line A
	  ## (($exitcode == 0) ?                                     # line B
	    'ok  ' : 'ERR ' ) .
	  " ($exitcode) $pruned_path$suffix\n\n");

  $::debug && do {
    for (@lines) {
      print "> in \@ lines: $_";
    }
  };
  print LOGFILE @lines;	 # caller will close file
  return $exitcode;
}

# make all needed symlinks
sub make_symlinks {
  my($SCRIPTPATH) = "$LOCALDIR/$SCRIPTNAME";
  -e "$SCRIPTPATH" || 
    die "$::myname: error: cannot find program '$SCRIPTPATH': $!\n";
  -x "$SCRIPTPATH" || 
    die "$::myname: '$SCRIPTPATH' is not executable\n";
  print "$::myname: found executable '$SCRIPTPATH'\n";

  my($k, $v);
  my($OCFPAT) = quotemeta($OCF);
  my($LSBPAT) = quotemeta($LSB);
  KEY: for $k (sort keys %paths) {
    $v = $paths{$k};
    # is $k a simple name, not a pathname?
    if ($k =~ m|^/|) {
      warn "$::myname: key '$k' begins with '/', skipped\n";
      next KEY;
    }
    # Is $v a full path and executable?
    if ($v !~ m|^/|) {
      warn "$::myname: key '$k' value '$v' does not begin with '/', skipped\n";
      next KEY;
    }
    if (! -e $v) {
      warn "$::myname: key '$k' value '$v' does not exist: $!\n";
    } elsif (! -x $v) {
      warn "$::myname: key '$k' value '$v' is not executable\n";
    }
    my($symlink, $target);
    # rmeove any * prefix
    $k =~ s/^\*//;
    if ($v =~ m|^${OCF}|) {
      # for ocf scripts, symlinks is just name of our script
      $symlink = "$LOCALDIR/$k";
      $target = $SCRIPTNAME;
    } elsif ($v =~ m|^${LSB}|) {
      # for lsb scripts, symlinks is full pathname of our script
      $symlink = "$LSB/$k";
      $target = "$LOCALDIR/$SCRIPTNAME";
    } else {
      warn "$::myname error: key '$k' value '$v' is not within '$OCF' or '$LSB', skipped\n";
      next KEY;
    }
    # skip existing symlinks pointing to same location, repoint other
    # existing symlinks, and make new ones
    lstat $symlink;
    if (-e _) {
      # exists
      if (! -s _) {
	# is not a symlink
	warn "$::myname: error: '$symlink' already exist and is not a symlink; will not overwrite\n";
	next KEY;
      }
      # is a symlink; get its value
      my($oldtarget) = readlink($symlink);
      defined($oldtarget) || do {
	warn "$::myname: can't find where existing symlink '$symlink' points, will not overwrite\n";
	next KEY;
      };
      # if it already points to the same place, skip it
      if ($oldtarget eq $target) {
	print "$::myname: unchanged symlink '$symlink' -> '$target'\n";
	next KEY;
      }
      # repoint existing symlink
      unlink($symlink);
      if (symlink($target, $symlink)) {
	print "$::myname: repointed symlink '$symlink' -> was '$oldtarget' now '$target'\n";
      } else {
	warn "$::myname: can't symlink '$symlink' -> '$target': $!\n";
      }
    } else {
      # does not yet exist, create it
      if (symlink($target, $symlink)) {
	print "$::myname: made symlink '$symlink' -> '$target'\n";
      } else {
	warn "$::myname: can't symlink '$symlink' -> '$target': $!\n";
      }
    }
  }
}

sub givehelp {
   print <<EOF;
$::usage

  -x		Enable debugging -- for program maintainers.
  -X		Enable more debugging -- for program maintainers.
  -s		Make all needed symlinks within $OCF

This script allows you to trace Pacemaker calls to resource
agents, with all arguments and output recorded in the log
file $LOGFILE. See the source code for more details.

EOF
}
